Improvement for each track weighted by percent of PBs that week compared to total.
Improvement for each track weighted by percent of PBs that week compared to total.
| Track | PB Date | PB | WR Diff | |
|---|---|---|---|---|
| Mushroom | Mario Kart Stadium | 2022-08-14 | 1M 45.158S | 10.446 |
| Water Park | 2022-08-14 | 1M 48.01S | 7.826 | |
| Sweet Sweet Canyon | 2022-08-17 | 1M 55.716S | 6.871 | |
| Thwomp Ruins | 2022-07-23 | 1M 56.663S | 7.688 | |
| Flower | Mario Circuit | 2022-08-17 | 1M 53.422S | 8.091 |
| Toad Harbor | 2022-08-17 | 2M 12.859S | 10.521 | |
| Twisted Mansion | 2022-08-14 | 2M 4.604S | 10.144 | |
| Shy Guy Falls | 2022-08-15 | 2M 7.893S | 11.685 | |
| Star | Sunshine Airport | 2022-08-15 | 2M 9.102S | 10.999 |
| Dolphin Shoals | 2022-08-15 | 2M 5.647S | 12.241 | |
| Electrodrome | 2022-08-15 | 2M 7.453S | 11.488 | |
| Mount Wario | 2022-08-31 | 1M 51.45S | 9.467 | |
| Special | Cloudtop Cruise | 2022-08-17 | 2M 11.339S | 11.553 |
| Bone-Dry Dunes | 2022-09-11 | 1M 58.815S | 11.903 | |
| Bowser’s Castle | 2022-08-17 | 2M 9.397S | 10.402 | |
| Rainbow Road | 2022-08-17 | 2M 11.477S | 12.163 | |
| Shell | Wii Moo Moo Meadows | 2022-08-17 | 1M 31.958S | 7.498 |
| GBA Mario Circuit | 2022-09-02 | 1M 31.131S | 7.294 | |
| DS Cheep Cheep Beach | 2022-08-17 | 1M 56.547S | 9.499 | |
| N64 Toad’s Turnpike | 2022-08-17 | 1M 53.609S | 7.236 | |
| Banana | GCN Dry Dry Desert | 2022-09-02 | 2M 5.475S | 11.851 |
| SNES Donut Plains 3 | 2022-08-31 | 1M 23.495S | 10.662 | |
| N64 Royal Raceway | 2022-08-17 | 2M 7.086S | 11.432 | |
| 3DS DK Jungle | 2022-08-14 | 2M 12.646S | 11.470 | |
| Leaf | DS Wario Stadium | 2022-08-14 | 2M 3.195S | 12.201 |
| GCN Sherbet Land | 2022-09-02 | 1M 58.752S | 11.754 | |
| 3DS Music Park | 2022-07-03 | 2M 3.551S | 12.572 | |
| N64 Yoshi Valley | 2022-08-14 | 2M 6.218S | 7.787 | |
| Lightning | DS Tick-Tock Clock | 2022-08-14 | 1M 54.861S | 12.516 |
| 3DS Piranha Plant Slide | 2022-08-14 | 2M 9.61S | 10.386 | |
| Wii Grumble Volcano | 2022-08-19 | 2M 4.488S | 11.300 | |
| N64 Rainbow Road | 2022-08-14 | 1M 26.372S | 6.383 | |
| Egg | GCN Yoshi Circuit | 2022-08-14 | 1M 54.189S | 12.051 |
| Excitebike Arena | 2022-08-18 | 1M 50.425S | 10.438 | |
| Dragon Driftway | 2022-08-19 | 1M 50.088S | 9.468 | |
| Mute City | 2022-09-11 | 1M 59.807S | 8.529 | |
| Triforce | Wii Wario’s Gold Mine | 2022-08-15 | 2M 10.678S | 8.136 |
| SNES Rainbow Road | 2022-08-18 | 1M 34.172S | 7.904 | |
| Ice Ice Outpost | 2022-09-05 | 1M 55.067S | 9.851 | |
| Hyrule Circuit | 2022-08-18 | 1M 57.341S | 9.666 | |
| Crossing | GCN Baby Park | 2022-08-15 | 1M 10.013S | 7.871 |
| GBA Cheese Land | 2022-09-02 | 1M 54.367S | 12.431 | |
| Wild Woods | 2022-08-18 | 1M 54.225S | 8.212 | |
| Animal Crossing | 2022-08-17 | 1M 45.158S | 8.456 | |
| Bell | 3DS Neo Bowser City | 2022-09-03 | 1M 54.095S | 11.524 |
| GBA Ribbon Road | 2022-08-14 | 1M 54.584S | 9.197 | |
| Super Bell Subway | 2022-08-15 | 1M 51.517S | 11.027 | |
| Big Blue | 2022-08-14 | 1M 32.2S | 8.617 | |
| Golden Dash | Tour Paris Promenade | 2022-08-14 | 1M 58.784S | 8.417 |
| 3DS Toad Circuit | 2022-08-14 | 1M 28.148S | 7.731 | |
| N64 Choco Mountain | 2022-08-14 | 2M 2.045S | 9.375 | |
| Wii Coconut Mall | 2022-08-14 | 1M 51.731S | 9.964 | |
| Lucky Cat | Tour Tokyo Blur | 2022-08-14 | 1M 32.191S | 6.361 |
| DS Shroom Ridge | 2022-08-14 | 1M 55.359S | 10.367 | |
| GBA Sky Garden | 2022-08-14 | 1M 36.277S | 9.054 | |
| Tour Ninja Hideaway | 2022-06-19 | 2M 2.145S | 9.431 | |
| Turnip | Tour New York Minute | 2022-08-14 | 1M 32.608S | 9.488 |
| SNES Mario Circuit 3 | 2022-08-14 | 1M 43.171S | 12.007 | |
| N64 Kalimari Desert | 2022-08-14 | 1M 39.011S | 9.507 | |
| DS Waluigi Pinball | 2022-08-06 | 2M 30.8S | 11.305 | |
| Propeller | Tour Sydney Sprint | 2022-08-11 | 2M 11.751S | 10.950 |
| GBA Snow Land | 2022-08-06 | 1M 38.503S | 11.622 | |
| Wii Mushroom Gorge | 2022-08-06 | 1M 41.276S | 13.720 | |
| Sky-High Sundae | 2022-08-04 | 2M 7.354S | 11.886 |
---
title: "Mario Kart Time Trial PBs"
output:
flexdashboard::flex_dashboard:
orientation: rows
theme: sandstone
navbar:
- { title: "Speedruns", href: "sr.html", align: right}
- { icon: "fas fa-home", href: "index.html", align: right}
favicon: favicon.png
source_code: embed
---
<script>
$(document).ready(function(){
$('[data-toggle="popover"]').popover();
});
</script>
```{r lib}
library(tidyverse)
library(flexdashboard)
library(rvest)
library(plotly)
library(lubridate)
library(knitr)
library(kableExtra)
library(DT)
library(emojifont)
```
```{r scrapeWRs}
# Use rvest to scrape WR leaderboard
html <- read_html("http://www.mkwrs.com/mk8dx/wrs.php")
wr0 <- html %>% html_elements(".wr") %>% html_table() %>% .[[1]] %>%
rename_with(tolower, everything()) %>%
select(track, total = `time+video`, player, date) %>%
filter(track != "Total:") %>%
mutate(total = str_replace_all(total, "'", ":"),
total = str_replace_all(total, "\"", "."))
# Labels for violin plot (player name & date). Supports ties.
wr_label <- wr0 %>%
group_by(track) %>%
mutate(label = paste0(player, " (", date, ")"),
n = row_number()) %>%
ungroup() %>%
select(-c(player, date)) %>%
pivot_wider(names_from = n,
values_from = label,
names_prefix = "lab_") %>%
unite("label",
starts_with("lab_"),
sep = " &<br>",
na.rm = TRUE) %>%
mutate(label = paste0("<b>", total, "<b><br>", label)) %>%
select(-total)
# Use to join w/ other data & compare
wr <- wr0 %>%
select(track, WR_total = total) %>%
mutate(WR_total = ms(WR_total)) %>%
distinct()
rm(html, wr0)
```
```{r import}
abr <- read_csv("_data/abr.csv") %>%
mutate(track = ifelse(!is.na(source), paste(source, short), short)) %>%
select(trkNO, trk, track, cup, type) %>%
mutate(track = fct_inorder(track),
cup = fct_inorder(cup))
ctrk <- abr$track
ccup <- unique(abr$cup)
tt <- read_csv("_data/time-trials.csv",
col_types = cols(total = "c")) %>%
filter(cc == 150) %>%
left_join(abr, by = "trk") %>%
select(-c(cc, trk, starts_with("lap"))) %>%
mutate(
total = ms(total),
yr = year(date),
mth = month(date),
wk = week(date) - 4,
day = day(date),
hour = hour(time),
min = minute(time),
dt = make_datetime(
year = yr,
month = mth,
day = day,
hour = hour,
min = min
)
) %>%
select(trkNO:type, total, date, dt, yr, wk) %>%
arrange(track, dt) %>%
group_by(track) %>%
mutate(
improve = round(as.double(lag(total) - total, units = "secs"), 3),
improve = replace_na(improve, 0),
cumsum = cumsum(improve)
) %>%
ungroup()
tt_PB <- tt %>%
select(track, total, dt) %>%
group_by(track) %>%
slice_max(dt) %>%
ungroup() %>%
left_join(wr, by = "track") %>%
mutate(WR_diff = round(as.double(total - WR_total, units = "secs"), 3))
tt_all <- tt %>%
left_join(tt_PB, by = c("track", "total", "dt")) %>%
mutate(track = factor(track, levels = ctrk))
wk_now <- as_tibble_col(1:(week(today()) - 4))
```
# Tracks 1-48
```{r}
tt_48 <- tt_all %>%
filter(trkNO < 49) %>%
group_by(track) %>%
mutate(sd = sd(total)) %>%
ungroup()
```
## Value Boxes
```{r}
v_worst_48 <- slice_max(tt_48, WR_diff)
v_best_48 <- slice_min(tt_48, WR_diff)
v_new_48 <- slice_max(tt_48, dt)
v_old_48 <- slice_min(tt_48, dt)
```
### Best Track (`r v_best_48$WR_diff`S from WR)
```{r}
valueBox(value = v_best_48$track,
icon = "fa fa-splotch")
```
### Worst Track (`r v_worst_48$WR_diff`S from WR)
```{r}
valueBox(value = v_worst_48$track,
icon = "fa fa-poo")
```
### Most Recent PB (Set on `r v_new_48$date`)
```{r}
valueBox(value = v_new_48$track,
icon = "fa fa-hourglass-start")
```
### Oldest PB (Set on `r v_old_48$date`)
```{r}
valueBox(value = v_old_48$track,
icon = "fa fa-hourglass-end")
```
## Graphs
```{r}
PBs <- count(tt_48)
tt_48_wk <- tt_48 %>%
group_by(wk) %>%
mutate(n = n(),
th = sum(improve * n),
wmean = th / PBs$n) %>%
ungroup() %>%
select(wk, wmean, n) %>%
distinct() %>%
full_join(wk_now, by = c("wk" = "value")) %>%
mutate(across(2:3, ~ replace_na(.x, 0))) %>%
arrange(wk)
```
### PBs by Week
```{r}
gg_48_wk <- tt_48_wk %>%
ggplot() +
geom_line(aes(x=wk, y=n), color = "#ecc371") +
theme_minimal() +
labs(y = "",
x = "Week")
ggplotly(gg_48_wk)
```
### Weighted Average Improvement by Week
```{r}
gg_48_wk_wt <- tt_48_wk %>%
ggplot(aes(x=wk, y=wmean)) +
geom_line(color = "#85a1ac") +
theme_minimal() +
labs(x = "Week",
y = "Improvement (secs)")
ggplotly(gg_48_wk_wt)
```
> Improvement for each track weighted by percent of PBs that week compared to total.
### Cumulative Improvement
```{r}
gg_cts_48 <- tt_48 %>%
filter(improve != 0) %>%
arrange(dt) %>%
mutate(cumsum = cumsum(improve)) %>%
ggplot(aes(x=dt, y=cumsum)) +
geom_step(color = "#6868ac") +
theme_minimal() +
labs(x="", y="Improvement (secs)") +
theme(axis.text.x = element_text(angle = 90),
legend.position = "none")
ggplotly(gg_cts_48)
```
## Violin
### PB Time Distributions, Feb 01, 2022 - Present
```{r violin48, fig.height=10}
gg_48 <- tt_48 %>%
filter(track != "GCN Baby Park") %>%
ggplot(aes(factor(track), total)) +
geom_violin(draw_quantiles = 0.5,
scale = "width",
aes(fill = sd, color=sd),
alpha = .7) +
stat_summary(fun = "mean", geom = "crossbar", size = .2, aes(color = sd)) +
stat_summary(fun = "median", geom = "point", size = .4) +
geom_text(aes(factor(track), WR_total),
label = emoji("trophy"),
family = 'EmojiOne',
size = 3) +
scale_fill_gradient(low = "darkcyan", high = "plum") +
scale_color_gradient(low = "darkcyan", high = "plum") +
scale_y_time() +
scale_x_discrete() +
labs(x = "",
y = "") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45,
hjust = 0.98,
vjust = 0.9),
axis.text = element_text(size = 8),
axis.ticks = element_line(size = .2),
panel.grid = element_line(size = .2),
panel.border = element_rect(fill = NA, size = .2),
legend.position = "none")
ggplotly(gg_48)
```
# Tracks 49-96
```{r}
tt_96 <- tt_all %>%
filter(trkNO > 48) %>%
group_by(track) %>%
mutate(sd = sd(total)) %>%
ungroup()
```
## Value Boxes
```{r}
v_worst_96 <- slice_max(tt_96, WR_diff)
v_best_96 <- slice_min(tt_96, WR_diff)
v_new_96 <- slice_max(tt_96, dt)
v_old_96 <- slice_min(tt_96, dt)
```
### Best Track (`r v_best_96$WR_diff`S from WR)
```{r}
valueBox(value = v_best_96$track,
icon = "fa fa-splotch")
```
### Worst Track (`r v_worst_96$WR_diff`S from WR)
```{r}
valueBox(value = v_worst_96$track,
icon = "fa fa-poo")
```
### Most Recent PB (Set on `r v_new_96$date`)
```{r}
valueBox(value = v_new_96$track,
icon = "fa fa-hourglass-start")
```
### Oldest PB (Set on `r v_old_96$date`)
```{r}
valueBox(value = v_old_96$track,
icon = "fa fa-hourglass-end")
```
## Graphs {data-width=330}
```{r}
PBs_96 <- count(tt_96)
wk_now_96 <- wk_now %>%
filter(value > 6)
tt_96_wk <- tt_96 %>%
group_by(wk) %>%
mutate(n = n(),
wt = n / PBs_96$n,
wmean = sum(improve * wt)) %>%
ungroup() %>%
select(wk, wmean, n) %>%
distinct() %>%
full_join(wk_now_96, by = c("wk" = "value")) %>%
mutate(across(2:3, ~ replace_na(.x, 0))) %>%
arrange(wk)
```
### PB Count by Week
```{r}
gg_96_wk <- tt_96_wk %>%
ggplot() +
geom_line(aes(x=wk, y=n), color = "#ecc371") +
theme_minimal() +
labs(y = "",
x = "")
ggplotly(gg_96_wk)
```
### Weighted Average Improvement by Week
```{r}
gg_96_wk_wt <- tt_96_wk %>%
ggplot(aes(x=wk, y=wmean)) +
geom_line(color = "#85a1ac") +
theme_minimal() +
labs(x = "",
y = "Improvement")
ggplotly(gg_96_wk_wt)
```
> Improvement for each track weighted by percent of PBs that week compared to total.
### Cumulative Improvement
```{r}
gg_cts_96 <- tt_96 %>%
filter(improve != 0) %>%
arrange(dt) %>%
mutate(cumsum = cumsum(improve)) %>%
ggplot(aes(x=dt, y=cumsum)) +
geom_step(color = "#6868ac") +
theme_minimal() +
labs(x="", y="Improvement (secs)") +
theme(axis.text.x = element_text(angle = 90),
legend.position = "none")
ggplotly(gg_cts_96)
```
## Violin
### PB Time Distributions
```{r violin96, fig.height=10}
gg_96 <- tt_96 %>%
group_by(track) %>%
mutate(sd = sd(total)) %>%
ungroup() %>%
ggplot(aes(factor(track), total)) +
geom_violin(draw_quantiles = 0.5,
scale = "width",
aes(fill = sd, color=sd),
alpha = .7) +
stat_summary(fun = "mean", geom = "crossbar", size = .2, aes(color = sd)) +
stat_summary(fun = "median", geom = "point", size = .4) +
geom_text(aes(factor(track), WR_total),
label = emoji("trophy"),
family = 'EmojiOne',
size = 3) +
scale_fill_gradient(low = "darkcyan", high = "plum") +
scale_color_gradient(low = "darkcyan", high = "plum") +
scale_y_time() +
scale_x_discrete() +
labs(x = "",
y = "") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45,
hjust = 0.98,
vjust = 0.9),
axis.text = element_text(size = 8),
axis.ticks = element_line(size = .2),
panel.grid = element_line(size = .2),
panel.border = element_rect(fill = NA, size = .2),
legend.position = "none")
ggplotly(gg_96)
```
# Tables {data-orientation=columns}
## Current PBs {.tabset data-width=500}
```{r}
tt_tbl <- tt_all %>%
select(trkNO, cup, track, date, total, improve, WR_total, WR_diff) %>%
select(-trkNO)
PB_tbl <- tt_tbl %>%
filter(!is.na(WR_total)) %>%
select(-improve)
```
### Current PBs
```{r}
PB_tbl %>%
kbl(
col.names = c(" ", "Track", "PB Date", "PB", "WR", "WR Diff"),
align = "c",
escape = FALSE,
longtable = TRUE
) %>%
kable_styling(full_width = TRUE) %>%
column_spec(column = 1,
extra_css = 'transform: rotate(270deg);') %>%
column_spec(3:4,
extra_css = 'font-size: 80%;') %>%
column_spec(
6,
color = "white",
background = spec_color(
PB_tbl$WR_diff,
begin = 0.3,
end = 0.7,
alpha = 0.7,
option = "A"
),
popover = paste0("WR: ", PB_tbl$WR_total)
) %>%
remove_column(5) %>%
collapse_rows(columns = 1,
row_group_label_position = 'stack') %>%
row_spec(0, align = "c")
```
## All Records {.tabset}
### All Records
```{r}
tt_tbl %>%
select(-WR_total) %>%
mutate(total = paste(total),
improve = ifelse(improve == 0, NA, improve)) %>%
arrange(desc(WR_diff)) %>%
datatable(
rownames = FALSE,
colnames = c("Cup", "Track", "PB Date", "PB",
"Improvement", "WR Diff"),
filter = 'top',
options = list(pageLength = 48,
autoWidth = TRUE,
columnDefs = list(
list(className = 'dt-center', targets = 0:3)
))
) %>%
formatStyle(3:6, `font-size` = '80%')
```